perm filename FLOPS.SAI[4,ALS] blob sn#057484 filedate 1973-08-09 generic text, type T, neo UTF8
00010	BEGIN "FLIPS"
00015	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00020	INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
00030	INTEGER ARRAY BUF,FLOPS[0:1000];
00040	STRING FILEN,READ,READ1,FILEO,READ2;
00050	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00052	⊂ STATE=0 means on way up
00054	  STATE=1 means on way down;
00060	
00070	FILEN←"FLTD.001[DAT,NJM]";
00080	OUTSTR("Type file name (CR for "&FILEN&".");
00090	IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
00091	  READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
00092	  READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
00094	  IF READ2="." THEN DONE; END;
00095	  FILEO←READ1&"FLP";
00098	  POINTY←POINT(6,FLOPS[0],-1);
00100	OUTSTR("Specify DELTA (CR for 20) ");
00110	IF (READ←INCHWL)="" THEN DELTA←20 ELSE DELTA←CVD(READ);
00120	CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00130	LOOKUP(CHAN1,FILEN,0);
00140	J←K←L←STATE←VAL←R←0;
00150	OUTSTR(CRLF&"Frication measure on file "&FILEN
00160	   &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00170	SETFORMAT(6,0);
00180	FOR I←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(I)); OUTSTR(CRLF&LF);
00190	Q←0; OUTSTR(CVS(Q)&TB);
00200	WHILE EOF=0 DO BEGIN
00220	  FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
00230	  ARRYIN(CHAN1,BUF[0],1000);
00240	  POINTX←POINT(12,BUF[0],-1);
00250	FOR I←0 STEP 1 UNTIL 29 DO BEGIN
00260	  M←0;
00270	  FOR J←0 STEP 1 UNTIL 99 DO BEGIN
00280	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00290	    IF STATE=0 THEN BEGIN
00300	      IF VAL<K-DELTA THEN BEGIN
00310	      M←M+1; STATE←-1; END; END ELSE
00330	     IF VAL>K+DELTA THEN  BEGIN
00340	      M←M+1; STATE←0; END;
00345	    K←VAL;
00350	    END;
00360	N←M;
00370	 IF N>20 THEN N←N-20 ELSE N←0;
00380	IF N≤63 THEN IDPB(N,POINTY) ELSE IDPB(63,POINTY); R←R+1;
00390	  IF N>0 THEN OUTSTR(CVS(N)) ELSE OUTSTR("      ");
00395	  IF (P MOD 10)=9 THEN BEGIN Q←Q+10;
00400	  OUTSTR(CRLF&CVS(Q)&TB); P←0; END ELSE P←P+1;
00410	  END;
00450	END;
00460	
00461	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00462	ENTER(CHAN1,FILEO,0); R←R%6+2;
00463	ARRYOUT(CHAN1,FLOPS[0],R); RELEASE(CHAN1);
00470	END "FLIPS";